home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / manchest.lha / MANCHESTER / manchester / 2.2 / actors / Grapher.st < prev    next >
Text File  |  1993-07-24  |  57KB  |  2,166 lines
  1. "    NAME        Grapher
  2.     AUTHOR        manchester
  3.     FUNCTION    ?
  4.     ST-VERSION    2.2
  5.     PREREQUISITES    
  6.     CONFLICTS
  7.     DISTRIBUTION    world
  8.     VERSION        1
  9.     DATE    19 Aug 1988"
  10. ScrollController subclass: #XAxisScrollController
  11.     instanceVariableNames: 'xScrollBar xMarker xSavedArea '
  12.     classVariableNames: ''
  13.     poolDictionaries: ''
  14.     category: 'Grapher'!
  15. XAxisScrollController comment:
  16. 'I represent control for scrolling using an x-axis scroll bar.  I am a subclass of ScrollController that creates an x-axis scroll bar.  My subclasses then have x and y-axis
  17. scroll bars.  I keep control as long as the cursor is inside the view or either one of the scroll bars.
  18.  
  19. The y-axis scroll bar is a rectangular area representing the length of the information being viewed.  It contains an inner rectangle whose top y-coordinate represents the relative position of the information visible on the screen with respect to all of the information, and whose size represents the relative amount of that information visible on the screen.  The user controls which part of the information is visible by pressing the red button.  If the cursor is to the right of the inner rectangle, the windo
  20.  
  21.  
  22.  
  23. w onto the visible information moves upward, if the cursor is to the left, the window moves downward, and if the cursor is inside, the inner rectangle is grabbed and moved to a desired position.  The x-axis scroll bar is controlled in an analogous manner.  
  24.  
  25. Instance Variables:
  26.     xScrollBar    <Quadrangle> inside white, the outer rectangle
  27.     xMarker        <Quadrangle> inside gray, the inner rectangle
  28.     xSavedArea    <Form> the area the xScrollBar overlaps, restored whenever
  29.                 the xScrollBar is hidden
  30.     '!
  31.  
  32.  
  33. !XAxisScrollController methodsFor: 'initialize-release'!
  34.  
  35. initialize
  36.     super initialize.
  37.     xScrollBar _ Quadrangle new.
  38.     xScrollBar borderWidthLeft: 2 right: 2 top: 0 bottom: 2.
  39.     xMarker _ Quadrangle new.
  40.     xMarker insideColor: Form gray! !
  41.  
  42. !XAxisScrollController methodsFor: 'basic control sequence'!
  43.  
  44. controlInitialize
  45.     "The scrollbar has a two-pixel border, and for alignment it assumes that this sub-view
  46.     has a one-pixel border and shares another one-pixel border from its neighbor/super view"
  47.     super controlInitialize.
  48.     xScrollBar region: (0 @ 0 extent: (view displayBox width + 2) @ 32). 
  49.     xMarker region: self computeXMarkerRegion.
  50.     xScrollBar _ xScrollBar align: xScrollBar topLeft with: view displayBox bottomLeft - (1@0).
  51.     xMarker _ xMarker align: xMarker leftCenter with: xScrollBar inside leftCenter.
  52.     xSavedArea _ Form fromDisplay: xScrollBar.
  53.     xScrollBar displayOn: Display.
  54.     self moveXMarker!
  55.  
  56. controlTerminate
  57.     super controlTerminate.
  58.     xSavedArea notNil     
  59.         ifTrue: 
  60.             [xSavedArea displayOn: Display at: xScrollBar topLeft.
  61.             xSavedArea_ nil]! !
  62.  
  63. !XAxisScrollController methodsFor: 'control defaults'!
  64.  
  65. controlActivity
  66.  
  67.     self xScrollBarContainsCursor
  68.         ifTrue: [self xScroll]
  69.         ifFalse: [super controlActivity]!
  70.  
  71. isControlActive
  72.  
  73.     ^self xScrollBarContainsCursor or: [super isControlActive]! !
  74.  
  75. !XAxisScrollController methodsFor: 'scroll bar region'!
  76.  
  77. repaintUnderScrollBar
  78.     "Repaint the area under the scroll bar ."
  79.  
  80.     super repaintUnderScrollBar.
  81.     self repaintUnderXScrollBar!
  82.  
  83. repaintUnderXScrollBar
  84.     "Repaint the area under the scroll bar ."
  85.  
  86.     xSavedArea notNil     
  87.         ifTrue: 
  88.             [xSavedArea displayOn: Display at: xScrollBar topLeft.
  89.             xSavedArea_ nil]! !
  90.  
  91. !XAxisScrollController methodsFor: 'scrolling'!
  92.  
  93. canXScroll
  94.     "Answer whether there is information that is not visible and can be seen
  95.     by scrolling."
  96.     ^xMarker region width < xScrollBar inside width!
  97.  
  98. scrollViewLeft
  99.     "Scroll the receiver's view left the default amount."
  100.     self xScrollView: self xScrollAmount negated!
  101.  
  102. scrollViewNoDisplay: delta
  103.  
  104.     | t2 |
  105.     delta ~= 0
  106.         ifTrue: 
  107.             [t2 _ (delta min: view window top - model boundingBox top)
  108.                         max: view window top - model boundingBox bottom.
  109.             view scrollBy: 0 @ t2]!
  110.  
  111. scrollViewRight
  112.     "Scroll the receiver's view right the default amount."
  113.     self xScrollView: self xScrollAmount!
  114.  
  115. viewXDelta
  116.     "Answer an integer that indicates how much the view should be scrolled.
  117.     The scroll bar has been moved and now the view must be so the amount to
  118.     scroll is computed as a ratio of the current scroll bar position."
  119.  
  120.     ^view window left - view boundingBox left -
  121.         ((xMarker left - xScrollBar inside left) asFloat /
  122.             xScrollBar inside width asFloat *
  123.                 view boundingBox width asFloat) rounded!
  124.  
  125. xScroll
  126.     "Check to see whether the user wishes to jump, scroll left, or scroll right."
  127.  
  128.     | savedCursor regionPercent |
  129.     savedCursor _ sensor currentCursor.
  130.     [self xScrollBarContainsCursor]
  131.         whileTrue: 
  132.             [Processor yield.
  133.             regionPercent _ 100 * (xScrollBar inside bottom  - sensor cursorPoint y) // xScrollBar height.
  134.             regionPercent <= 40
  135.                 ifTrue: [self scrollLeft]
  136.                 ifFalse: [regionPercent >= 60
  137.                             ifTrue: [self scrollRight]
  138.                             ifFalse: [self xScrollAbsolute]]].
  139.     savedCursor show!
  140.  
  141. xScrollAmount
  142.     "Answer the number of bits of x-coordinate should be scrolled.  This is a 
  143.     default determination based on the view's preset display transformation."
  144.  
  145.     ^((view inverseDisplayTransform: sensor cursorPoint)
  146.         - (view inverseDisplayTransform: xScrollBar inside leftCenter)) x!
  147.  
  148. xScrollView
  149.     "The scroll bar jump method was used so that the view should be updated to
  150.     correspond to the location of the scroll bar gray area."
  151.     self xScrollView: self viewXDelta!
  152.  
  153. xScrollView: anInteger 
  154.     "If anInteger is not zero, tell the receiver's view to scroll by anInteger amount."
  155.  
  156.     anInteger ~= 0
  157.         ifTrue: 
  158.             [view scrollBy: ((anInteger min: view window left - view boundingBox left)
  159.                         max: view window left - view boundingBox right) @ 0.
  160.             view clearInside.
  161.             view display]! !
  162.  
  163. !XAxisScrollController methodsFor: 'cursor'!
  164.  
  165. xMarkerContainsCursor
  166.     "Answer whether the gray area inside the scroll bar area contains the cursor."
  167.     ^xMarker inside containsPoint: sensor cursorPoint!
  168.  
  169. xScrollBarContainsCursor
  170.     "Answer whether the cursor is anywhere within the scroll bar area."
  171.     ^xScrollBar inside containsPoint: sensor cursorPoint! !
  172.  
  173. !XAxisScrollController methodsFor: 'marker adjustment'!
  174.  
  175. computeXMarkerRegion
  176.     "Answer the rectangular area in which the gray area of the scroll bar
  177.     should be displayed."
  178.  
  179.     ^0@0 extent: ((view window width asFloat /
  180.                         view boundingBox width *
  181.                             xScrollBar inside width)
  182.                  rounded min: xScrollBar inside width) @ 10!
  183.  
  184. moveXMarker
  185.     "The view window has changed.  Update the xMarker."
  186.  
  187.     self moveXMarker: self xMarkerDelta negated!
  188.  
  189. moveXMarker: anInteger
  190.     "Update the xMarker so that is is translated by an amount corresponding to
  191.     a distance of anInteger, constrained within the boundaries of the scroll bar."
  192.  
  193.     Display fill: xMarker mask: xScrollBar insideColor.
  194.     xMarker _ xMarker translateBy: ((anInteger min: xScrollBar inside right - xMarker right) max:
  195.                     xScrollBar inside left - xMarker left) @ 0.
  196.     xMarker displayOn: Display!
  197.  
  198. xMarkerDelta
  199.     ^xMarker left 
  200.         - xScrollBar inside left  
  201.         - ((view window left - view boundingBox left) asFloat 
  202.             / view boundingBox width asFloat *
  203.                 xScrollBar inside width asFloat) rounded!
  204.  
  205. xMarkerRegion: aRectangle 
  206.     "Set the area defined by aRectangle as the xMarker.  Fill it with gray tone."
  207.  
  208.     Display fill: xMarker mask: xScrollBar insideColor.
  209.     xMarker region: aRectangle.
  210.     xMarker _ xMarker align: xMarker leftCenter with: xScrollBar inside leftCenter! !
  211.  
  212. !XAxisScrollController methodsFor: 'private'!
  213.  
  214. scrollLeft
  215.     "This is modified from the original to provide continuous scrolling"
  216.     self changeCursor: Cursor left.
  217.     sensor anyButtonPressed 
  218.         ifTrue: [self canXScroll
  219.                     ifTrue: 
  220.                         [self scrollViewLeft.
  221.                         self moveXMarker]].
  222.     sensor waitNoButton!
  223.  
  224. scrollRight
  225.     "This is modified from the original to provide continuous scrolling"
  226.     self changeCursor: Cursor right.
  227.     sensor anyButtonPressed
  228.         ifTrue: [self canXScroll
  229.                     ifTrue: 
  230.                         [self scrollViewRight.
  231.                         self moveXMarker]].
  232.     sensor waitNoButton!
  233.  
  234. xAndYScrollAbsolute
  235.  
  236.     | oldMarker oldXMarker savedCursor |
  237.     (((self canXScroll) or: [self canScroll])
  238.             and: [sensor redButtonPressed]) ifTrue:
  239.         [savedCursor _ sensor currentCursor.
  240.         self changeCursor: Cursor fourWay.
  241.         [sensor redButtonPressed] whileTrue:
  242.             [oldMarker _ marker.
  243.             oldXMarker _ xMarker.
  244.             marker _ marker translateBy:
  245.                 0@((sensor cursorPoint y - marker center y
  246.                         min: scrollBar inside bottom - marker bottom)
  247.                             max: scrollBar inside top - marker top).
  248.             xMarker _ xMarker translateBy:
  249.                 ((sensor cursorPoint x - xMarker center x
  250.                     min: xScrollBar inside right - xMarker right)
  251.                         max: xScrollBar inside left - xMarker left) @ 0.
  252.             (oldMarker areasOutside: marker),
  253.             (marker areasOutside: oldMarker),
  254.             (oldXMarker areasOutside: xMarker),
  255.             (xMarker areasOutside: oldXMarker) do:
  256.                 [:region | Display fill: region rule: Form reverse mask: Form gray].
  257.             self scrollViewNoDisplay: self viewDelta.
  258.             self xScrollView.
  259.             scrollBar display.
  260.             xScrollBar display.
  261.             self moveMarker.
  262.             self moveXMarker].
  263.         savedCursor show]!
  264.  
  265. xScrollAbsolute
  266.     | oldMarker |
  267.     self changeCursor: Cursor xMarker.
  268.     self canXScroll & sensor anyButtonPressed ifTrue:
  269.         [[sensor anyButtonPressed] whileTrue:
  270.             [oldMarker _ xMarker.
  271.             xMarker _ xMarker translateBy:
  272.                 ((sensor cursorPoint x - xMarker center x min:
  273.                     xScrollBar inside right - xMarker right) max: xScrollBar inside left - xMarker left) @ 0.
  274.             (oldMarker areasOutside: xMarker), (xMarker areasOutside: oldMarker) do:
  275.                 [:region | Display fill: region rule: Form reverse mask: Form gray]].
  276.             self xScrollView.
  277.             xScrollBar display.
  278.             self moveXMarker]! !XAxisScrollController subclass: #GraphHolderController
  279.     instanceVariableNames: 'scrollBox selection selectionMenu '
  280.     classVariableNames: 'YellowButtonMenu '
  281.     poolDictionaries: ''
  282.     category: 'Grapher'!
  283. GraphHolderController comment:
  284. 'As a subclass of XAxisScrollController I provide X and Y axis scrolling.  In addition, I provide ''smooth'' scrolling by red button dragging of the mouse.  I also am capable of responding to red button clicks to select an element of the display if I have a menu to activate for selections.  The menu is initialized by my selectionMenu: message which takes an ActionMenu as its argument. The message selectors included with the ActionMenu must be messages that the objects which make up the graph respond to.
  285.  
  286. My instance variables:
  287.  
  288.     scrollBox    <Rectangle>
  289.                 My scrollBox represents the area of the display which
  290.                 is visible on the screen.  It is in local view coordinates.
  291.     selection    <GraphNode>
  292.                 If an element of the display has been selected by clicking
  293.                 the mouse red button on it, it is saved here.
  294.     selectionMenu <Array of (PopUpMenu, Array of message selectors)>
  295.                 The yellow button menu to be activated when a selection
  296.                 has been made and the yellow button is pressed.  Menu
  297.                 messages are sent to the object field of the selected
  298.                 GraphNode.  If selectionMenu is nil the window does not
  299.                 respond to red button clicks (although red button scrolling
  300.                 is still available).
  301.  
  302. '!
  303.  
  304.  
  305. !GraphHolderController methodsFor: 'initialize-release'!
  306.  
  307. initialize
  308.     "I use an ActionMenu rather than a PopUpMenu so no
  309.     yellowButtonMessages are needed."
  310.  
  311.     yellowButtonMenu _ YellowButtonMenu.
  312.     scrollBox _ 0@0 extent: 0@0.
  313.     super initialize! !
  314.  
  315. !GraphHolderController methodsFor: 'accessing'!
  316.  
  317. noSelection
  318.     "Make the selection nil, and de-highlight if necessary."
  319.  
  320.     selection isNil ifFalse: [self deHighlightSelection].
  321.     selection _ nil.!
  322.  
  323. scrollBox: aRectangle
  324.     "My scrollBox is a Rectangle which pans over the virtual display of
  325.     my model.  My view looks through my scrollBox at the model.  Normally,
  326.     my window would perform this function, but windows get scaled and
  327.     I required an unscaled scrollBox."
  328.  
  329.     scrollBox _ Rectangle origin: 0@0 extent: aRectangle extent!
  330.  
  331. selection
  332.  
  333.     ^selection!
  334.  
  335. selectionMenu: anActionMenu
  336.  
  337.     selectionMenu _ anActionMenu! !
  338.  
  339. !GraphHolderController methodsFor: 'basic control sequence'!
  340.  
  341. controlInitialize
  342.  
  343.     selection == nil ifFalse: [self darkHighlightSelection].
  344.     super controlInitialize!
  345.  
  346. controlTerminate
  347.  
  348.     selection == nil ifFalse: [self dimHighlightSelection]. 
  349.     super controlTerminate! !
  350.  
  351. !GraphHolderController methodsFor: 'control defaults'!
  352.  
  353. controlActivity
  354.  
  355.     | cursorPoint xlate newSelection |
  356.     sensor redButtonPressed ifTrue:
  357.         [sensor leftShiftDown | (selectionMenu == nil)
  358.             ifTrue: [^self xAndYScrollAbsolute].
  359.         cursorPoint _ (sensor cursorPoint
  360.                             translateBy: scrollBox origin
  361.                                         - view displayTransformation translation
  362.                                         - model offset) rounded.
  363.         newSelection _ model selectNodeAt: cursorPoint.
  364.         self setSelection: newSelection.
  365.         newSelection == nil
  366.             ifTrue: [self xAndYScrollAbsolute]
  367.             ifFalse: [[sensor redButtonPressed & self isControlActive]
  368.                         whileTrue]].
  369.     super controlActivity!
  370.  
  371. isControlActive
  372.  
  373.     ^sensor blueButtonPressed not and: [super isControlActive]! !
  374.  
  375. !GraphHolderController methodsFor: 'menu messages'!
  376.  
  377. fileOutGraph
  378.     "Produce a PostScript file which will make a hardcopy version of my model."
  379.  
  380.     | aStream |
  381.     Cursor write showWhile:
  382.         [aStream _ FileStream fileNamed: 'diagps.script'.
  383.         model psStoreOn: aStream.
  384.         aStream close]!
  385.  
  386. localMenuItem: aSelector
  387.  
  388.     ^ #( #fileOutGraph ) includes: aSelector!
  389.  
  390. menuMessageReceiver
  391.  
  392.     selection == nil
  393.         ifTrue: [^self]
  394.         ifFalse: [sensor leftShiftDown
  395.             ifTrue: [^selection]
  396.             ifFalse: [^selection object]]!
  397.  
  398. yellowButtonActivity
  399.     "Determine which item in the yellow button pop-up menu is selected.
  400.     If one is selected, then send the corresponding message to the object
  401.     designated as the menu message receiver."
  402.  
  403.     | index selector |
  404.     yellowButtonMenu == nil
  405.         ifFalse: 
  406.             [index _ yellowButtonMenu startUpYellowButton.
  407.             index ~= 0 
  408.                 ifTrue:
  409.                     [selector _ yellowButtonMenu selectorAt: index.
  410.                     (self localMenuItem: selector)
  411.                         ifTrue: [self perform: selector]
  412.                         ifFalse: [self controlTerminate.
  413.                                 selector numArgs = 1
  414.                                     ifTrue: [self menuMessageReceiver perform: selector with: model]
  415.                                     ifFalse: [self menuMessageReceiver perform: selector].
  416.                                 self controlInitialize]]]! !
  417.  
  418. !GraphHolderController methodsFor: 'marker adjustment'!
  419.  
  420. computeMarkerRegion
  421.  
  422.     ^Rectangle
  423.         origin: 0 @ 0
  424.         extent: 10 @ ((scrollBox height asFloat /
  425.                             view boundingBox height asFloat *
  426.                                 scrollBar inside height) rounded
  427.                         min: scrollBar inside height)!
  428.  
  429. computeXMarkerRegion
  430.  
  431.     ^Rectangle
  432.         origin: 0 @ 0
  433.         extent: ((scrollBox width asFloat /
  434.                             view boundingBox width asFloat *
  435.                                 xScrollBar inside width) rounded
  436.                         min: xScrollBar inside width) @ 10!
  437.  
  438. markerDelta
  439.     ^marker top
  440.         - scrollBar inside top
  441.         - (scrollBox top - view boundingBox top asFloat 
  442.             / view boundingBox height asFloat *
  443.                 scrollBar inside height asFloat) rounded!
  444.  
  445. xMarkerDelta
  446.     ^xMarker left 
  447.         - xScrollBar inside left  
  448.         - (scrollBox left - view boundingBox left asFloat 
  449.             / view boundingBox width asFloat
  450.             * xScrollBar inside width asFloat) rounded! !
  451.  
  452. !GraphHolderController methodsFor: 'scrolling'!
  453.  
  454. scrollAmount
  455.  
  456.     ^(sensor cursorPoint - scrollBar inside topCenter) y!
  457.  
  458. scrollBy: amount
  459.  
  460.     scrollBox _ scrollBox translateBy: amount!
  461.  
  462. scrollView: anInteger 
  463.     "If anInteger is not zero, scroll by anInteger amount."
  464.  
  465.     | min max amount |
  466.     max _ view boundingBox top - scrollBox top min: 0.
  467.     min _ view boundingBox bottom - scrollBox bottom max: 0.
  468.     amount _ (anInteger negated max: max) min: min.
  469.     amount ~= 0
  470.         ifTrue: 
  471.             [self scrollBy: 0 @ amount.
  472.             view clearInside.
  473.             view display]!
  474.  
  475. scrollViewNoDisplay: anInteger 
  476.  
  477.     | min max amount |
  478.     max _ view boundingBox top - scrollBox top min: 0.
  479.     min _ view boundingBox bottom - scrollBox bottom max: 0.
  480.     amount _ (anInteger negated max: max) min: min.
  481.     amount ~= 0
  482.         ifTrue: 
  483.             [self scrollBy: 0 @ amount]!
  484.  
  485. scrollViewXY: aPoint 
  486.  
  487.     | amount ymax ymin xmax xmin |
  488.     ymax _ view boundingBox top - scrollBox top min: 0.
  489.     ymin _ view boundingBox bottom - scrollBox bottom max: 0.
  490.     xmax _ view boundingBox left - scrollBox left min: 0.
  491.     xmin _ view boundingBox right - scrollBox right max: 0.
  492.     amount _ Point x: ((aPoint x negated max: xmax) min: xmin) rounded
  493.                     y: ((aPoint y negated max: ymax) min: ymin) rounded.
  494.     amount ~= (0@0)
  495.         ifTrue: 
  496.             [self scrollBy: amount.
  497.             view clearInside.
  498.             view display]!
  499.  
  500. viewDelta
  501.     "Answer an integer that indicates how much the view should be scrolled.
  502.     The scroll bar has been moved and now the view must be so the amount to
  503.     scroll is computed as a ratio of the current scroll bar position."
  504.  
  505.     ^scrollBox top - view boundingBox top - 
  506.         ((marker top - scrollBar top) asFloat
  507.             / scrollBar height asFloat
  508.             * view boundingBox height asFloat) rounded!
  509.  
  510. viewXDelta
  511.     "Answer an integer that indicates how much the view should be scrolled.
  512.     The scroll bar has been moved and now the view must be so the amount to
  513.     scroll is computed as a ratio of the current scroll bar position."
  514.  
  515.     ^scrollBox left - view boundingBox left
  516.         - ((xMarker left - xScrollBar left) asFloat
  517.             / xScrollBar width asFloat
  518.             * view boundingBox width asFloat) rounded!
  519.  
  520. xScrollAmount
  521.  
  522.     ^(sensor cursorPoint - scrollBar inside leftCenter) x!
  523.  
  524. xScrollView: anInteger 
  525.     "If anInteger is not zero, scroll by anInteger amount."
  526.  
  527.     | min max amount |
  528.     max _ view boundingBox left - scrollBox left min: 0.
  529.     min _ view boundingBox right - scrollBox right max: 0.
  530.     amount _ (anInteger negated max: max) min: min.
  531.     amount ~= 0
  532.         ifTrue: 
  533.             [self scrollBy: amount @ 0.
  534.             view clearInside.
  535.             view display]! !
  536.  
  537. !GraphHolderController methodsFor: 'displaying'!
  538.  
  539. displayOn: aDisplayMedium transformation: aDisplayTransformation clippingBox: clippingBox rule: ruleInteger mask: halfTone
  540.  
  541.     | location |
  542.     location _ aDisplayTransformation applyTo: scrollBox origin x negated @ scrollBox origin y negated.
  543.     model form
  544.         displayOn: aDisplayMedium
  545.         at: location
  546.         clippingBox: clippingBox
  547.         rule: ruleInteger
  548.         mask: halfTone.
  549.     selection == nil ifFalse: [self darkHighlightSelection]! !
  550.  
  551. !GraphHolderController methodsFor: 'private'!
  552.  
  553. darkHighlightSelection
  554.  
  555.     | selectBox  |
  556.     selectBox _ (selection boundingBox
  557.                     translateBy: selection offset +
  558.                                   model offset +
  559.                                   view displayTransformation translation -
  560.                                   scrollBox origin) rounded.
  561.     (selection form) displayOn: Display
  562.                     at: (selectBox origin)
  563.                     clippingBox: (selectBox intersect: view insetDisplayBox)
  564.                     rule: 12
  565.                     mask: Form black!
  566.  
  567. deHighlightSelection
  568.  
  569.     | selectBox  |
  570.     selectBox _ (selection boundingBox
  571.                     translateBy: selection offset +
  572.                                   model offset +
  573.                                   view displayTransformation translation -
  574.                                   scrollBox origin) rounded.
  575.     (selection form) displayOn: Display
  576.                     at: (selectBox origin)
  577.                     clippingBox: (selectBox intersect: view insetDisplayBox)
  578.                     rule: Form over
  579.                     mask: Form black!
  580.  
  581. dimHighlightSelection
  582.  
  583.     | selectBox  newForm |
  584.     selectBox _ (selection boundingBox
  585.                     translateBy: selection offset +
  586.                                   model offset +
  587.                                   view displayTransformation translation -
  588.                                   scrollBox origin) rounded.
  589.     newForm _ selection form deepCopy.
  590.     newForm fill: (newForm boundingBox)
  591.             rule: Form under
  592.             mask: Form lightGray.
  593.     newForm displayOn: Display
  594.                     at: (selectBox origin)
  595.                     clippingBox: (selectBox intersect: view insetDisplayBox)
  596.                     rule: Form over
  597.                     mask: Form black!
  598.  
  599. setSelection: aGraphNode
  600.     "Set the currently selected node to aGraphNode and set
  601.     the yellowButtonMenu."
  602.  
  603.     selection == nil
  604.         ifFalse: [self deHighlightSelection].
  605.     selection _ aGraphNode.
  606.     selection == nil
  607.         ifTrue: [yellowButtonMenu _ YellowButtonMenu]
  608.         ifFalse: [self darkHighlightSelection.
  609.                 yellowButtonMenu _ selectionMenu]!
  610.  
  611. xAndYScrollAbsolute
  612.  
  613.     | savedCursor oldMarker oldXMarker cursorPoint delta |
  614.     ((self canXScroll or: [self canScroll])
  615.             and: [sensor redButtonPressed]) ifTrue:
  616.         [savedCursor _ sensor currentCursor.
  617.         self changeCursor: Cursor fourWay.
  618.         cursorPoint _ sensor cursorPoint.
  619.         [sensor redButtonPressed and: [self isControlActive]] whileTrue:
  620.             [[(sensor cursorPoint - cursorPoint) abs < (1@1)
  621.                 and: [sensor redButtonPressed]] whileTrue.
  622.             delta _ cursorPoint.
  623.             delta _ (cursorPoint _ sensor cursorPoint) - delta.
  624.             self scrollViewXY: delta.
  625.             self moveMarker.
  626.             self moveXMarker].
  627.         savedCursor show]! !
  628. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  629.  
  630. GraphHolderController class
  631.     instanceVariableNames: ''!
  632.  
  633.  
  634. !GraphHolderController class methodsFor: 'class initialization'!
  635.  
  636. initialize
  637.     "GraphHolderController initialize."
  638.  
  639.     YellowButtonMenu _ ActionMenu
  640.         labels: 'file out' withCRs
  641.         selectors: #( #fileOutGraph )! !
  642.  
  643. GraphHolderController initialize!
  644. View subclass: #GraphHolderView
  645.     instanceVariableNames: ''
  646.     classVariableNames: ''
  647.     poolDictionaries: ''
  648.     category: 'Grapher'!
  649. GraphHolderView comment:
  650. 'I provide a resizable View on graphical objects, without scaling the object.  To do this I maintain the standard cooridinate transformations of View, but I use only a transformation with unit scaling for display purposes.
  651.  
  652. Used as a subview of a StandardSystemView, I should be added via the addSubView:in:borderWidth: message to ensure proper rescaling during a resize operation.
  653. '!
  654.  
  655.  
  656. !GraphHolderView methodsFor: 'initialize-release'!
  657.  
  658. release
  659.     "If the #noform change protocol has been used, there is a circularity
  660.     in the Graph so release it, too."
  661.  
  662.     model release.
  663.     super release! !
  664.  
  665. !GraphHolderView methodsFor: 'window access'!
  666.  
  667. defaultWindow
  668.  
  669.     ^model boundingBox! !
  670.  
  671. !GraphHolderView methodsFor: 'controller access'!
  672.  
  673. defaultControllerClass
  674.  
  675.     ^GraphHolderController! !
  676.  
  677. !GraphHolderView methodsFor: 'display box access'!
  678.  
  679. computeBoundingBox
  680.  
  681.     ^boundingBox _ model boundingBox! !
  682.  
  683. !GraphHolderView methodsFor: 'displaying'!
  684.  
  685. display
  686.  
  687.     self isUnlocked ifTrue: [
  688.         boundingBox _ nil.
  689.         viewport _ nil.
  690.         self controller scrollBox: self insetDisplayBox].
  691.     super display!
  692.  
  693. displayView
  694.     "We always want to see the Graph at unit scale."
  695.  
  696.     controller
  697.                 displayOn: Display
  698.                 transformation: self displayTransformation copy scaleOfOne
  699.                 clippingBox: self insetDisplayBox
  700.                 rule: Form over
  701.                 mask: Form black! !
  702.  
  703. !GraphHolderView methodsFor: 'updating'!
  704.  
  705. update: how
  706.     "Graph's change protocol includes #form and #noform.  #form indicates
  707.     that the view is actually displaying a Form and does not need to clear
  708.     its inside during scrolling.  #noform indicates that the Graph is being
  709.     redisplayed each time the View scrolls, and the View must clear its
  710.     inside before redisplaying the Graph.  The boundingBox is always reset
  711.     because the size of the Graph changed."
  712.  
  713.     how == #form ifTrue:
  714.         [boundingBox _ nil.
  715.         self insideColor: nil.
  716.         ^self].
  717.     how == #noform ifTrue:
  718.         [boundingBox _ nil.
  719.         self insideColor: Form white.
  720.         ^self].
  721.     how == #all ifTrue: [
  722.         self topView isCollapsed ifFalse: [
  723.             self displaySafe: [
  724.                 boundingBox _ nil.
  725.                 controller noSelection.
  726.                 self insideColor: Form white.
  727.                 self clearInside.
  728.                 self displayView]]]! !
  729. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  730.  
  731. GraphHolderView class
  732.     instanceVariableNames: ''!
  733.  
  734.  
  735. !GraphHolderView class methodsFor: 'instance creation'!
  736.  
  737. openOn: roots label: labelString
  738.     "Create a Graph viewing the DAG rooted in roots.  Label the
  739.     GraphView with labelString.  The default lay out is horizontal.
  740.     See the comment in GraphView class.open:label:menu:"
  741.  
  742.     self openOn: roots label: labelString format: #( #horizontal )!
  743.  
  744. openOn: roots label: labelString format: formatSymbols
  745.     "By default, Graph windows do not respond to mouse clicks
  746.     (except for the yellow button menu)."
  747.  
  748.     self openOn: roots label: labelString format: formatSymbols menu: nil!
  749.  
  750. openOn: roots label: labelString format: formatSymbols menu: anActionMenu
  751.     "The default messages used to build a graph are #children and
  752.     #graphLabel.  #children returns a Colleciton of child nodes.
  753.     #graphLabel returns a Text to be used as the label in the GraphView."
  754.  
  755.     self openOn: roots
  756.         label: labelString
  757.         format: formatSymbols
  758.         menu: anActionMenu
  759.         childrenMsg: #children
  760.         labelMsg: #graphLabel!
  761.  
  762. openOn: roots label: labelString format: formatSymbols menu: actionMenu childrenMsg: childrenMsg labelMsg: labelMsg
  763.  
  764.     self open: (self createModel: roots
  765.                     children: childrenMsg
  766.                     label: labelMsg
  767.                     format: formatSymbols)
  768.         label: labelString
  769.         menu: actionMenu! !
  770.  
  771. !GraphHolderView class methodsFor: 'private'!
  772.  
  773. createModel: roots children: childrenMsg label: labelMsg format: formatSymbols
  774.  
  775.     | aGraph |
  776.     aGraph _ GraphHolder createForestWithRoots: roots
  777.                     children: childrenMsg
  778.                     label: labelMsg.
  779.     aGraph layout: formatSymbols.
  780.     ^aGraph!
  781.  
  782. open: aGraph label: labelString menu: anActionMenu
  783.     "Open a scrollable, resizeable view displaying the data structure
  784.     in aGraph.  To make the elements sensitive to mouse clicks anActionMenu
  785.     non nil. The message selected from the menu will be sent to the selected
  786.     element.  If anActionMenu is nil mouse clicks are ignored."
  787.  
  788.     | formView topView |
  789.     formView _ self new model: aGraph.
  790.     formView controller selectionMenu: anActionMenu.
  791.     topView _ StandardSystemView new label: labelString.
  792.     topView minimumSize: 200@200.
  793.     topView borderWidth: 1.
  794.     topView insideColor: Form white.
  795.     "formView is added as follows to ensure proper scaling of
  796.     the view when the topView is resized (via 'frame')."
  797.     topView addSubView: formView in: (0@0 extent: 1.0@1.0) borderWidth: 1.
  798.     topView controller open! !#('FourWay' 'LeftCursor' 'RightCursor' 'XMarkerCursor') do:
  799.     [ :var | Cursor addClassVarName: var].!
  800.  
  801.  
  802. !Cursor class methodsFor: 'constants'!
  803.  
  804. fourWay
  805.     "Answer the instance of me that is the shape of four connected arrows."
  806.     ^FourWay! !
  807.  
  808. !Cursor class methodsFor: 'constants'!
  809.  
  810. left
  811.     "Answer the instance of me that is the shape of an arrow facing to the left."
  812.     ^LeftCursor! !
  813.  
  814. !Cursor class methodsFor: 'constants'!
  815.  
  816. right
  817.     "Answer the instance of me that is the shape of an arrow facing to the right."
  818.     ^RightCursor! !
  819.  
  820. !Cursor class methodsFor: 'constants'!
  821.  
  822. xMarker
  823.     "Answer the instance of me that is displayed when thumb-scrolling on the x-axis."
  824.     ^XMarkerCursor! !
  825.  
  826. !Cursor class methodsFor: 'class initialization'!
  827.  
  828. initialize
  829.     "Create all the standard cursors
  830.         Cursor blank
  831.         Cursor corner
  832.         Cursor crossHair
  833.         Cursor down
  834.         Cursor execute
  835.         Cursor fourWay
  836.         Cursor left
  837.         Cursor marker
  838.         Cursor normal
  839.         Cursor origin
  840.         Cursor read
  841.         Cursor right
  842.         Cursor square
  843.         Cursor up
  844.         Cursor wait
  845.         Cursor write
  846.         Cursor xMarker"
  847.  
  848.     OriginCursor _   
  849.         (Cursor
  850.             extent: 16@16
  851.             fromArray: #(
  852.         2r1111111111111111
  853.         2r1111111111111111
  854.         2r1100000000000000
  855.         2r1100000000000000
  856.         2r1100000000000000
  857.         2r1100000000000000
  858.         2r1100000000000000
  859.         2r1100000000000000
  860.         2r1100000000000000
  861.         2r1100000000000000
  862.         2r1100000000000000
  863.         2r1100000000000000
  864.         2r1100000000000000
  865.         2r1100000000000000
  866.         2r1100000000000000
  867.         2r1100000000000000)
  868.             offset: -2@-2).
  869.  
  870.     CornerCursor _ 
  871.         (Cursor 
  872.             extent: 16@16
  873.             fromArray: #(
  874.         2r0000000000000011
  875.         2r0000000000000011
  876.         2r0000000000000011
  877.         2r0000000000000011
  878.         2r0000000000000011
  879.         2r0000000000000011
  880.         2r0000000000000011
  881.         2r0000000000000011
  882.         2r0000000000000011
  883.         2r0000000000000011
  884.         2r0000000000000011
  885.         2r0000000000000011
  886.         2r0000000000000011
  887.         2r0000000000000011
  888.         2r1111111111111111
  889.         2r1111111111111111)
  890.             offset: -14@-14).
  891.  
  892.     ReadCursor _  
  893.         (Cursor
  894.             extent: 16@16
  895.             fromArray: #(
  896.         2r0000110000000110
  897.         2r0001001000001001
  898.         2r0001001000001001
  899.         2r0010000000010000
  900.         2r0100000000100000
  901.         2r1111101111100000
  902.         2r1000010000100000
  903.         2r1000010000100000
  904.         2r1011010110100000
  905.         2r0111101111000000
  906.         2r0
  907.         2r0
  908.         2r0
  909.         2r0
  910.         2r0
  911.         2r0)
  912.     offset: 0@0).
  913.  
  914.     WriteCursor _ (Cursor
  915.     extent: 16@16
  916.     fromArray: #(
  917.         2r0000000000000110
  918.         2r0000000000001111
  919.         2r0000000000010110
  920.         2r0000000000100100
  921.         2r0000000001001000
  922.         2r0000000010010000
  923.         2r0000000100100000
  924.         2r0000001001000011
  925.         2r0000010010000010
  926.         2r0000100100000110
  927.         2r0001001000001000
  928.         2r0010010000001000
  929.         2r0111100001001000
  930.         2r0101000010111000
  931.         2r0110000110000000
  932.         2r1111111100000000)
  933.     offset: 0@0).
  934.  
  935.     WaitCursor _ 
  936.           (Cursor
  937.             extent: 16@16
  938.             fromArray: #(
  939.         2r1111111111111111
  940.         2r1000000000000001
  941.         2r0100000000000010
  942.         2r0010000000000100
  943.         2r0001110000111000
  944.         2r0000111101110000
  945.         2r0000011011100000
  946.         2r0000001111000000
  947.         2r0000001111000000
  948.         2r0000010110100000
  949.         2r0000100010010000
  950.         2r0001000110001000
  951.         2r0010001101000100
  952.         2r0100111111110010
  953.         2r1011111111111101
  954.         2r1111111111111111)
  955.             offset: 0@0).
  956.  
  957.     BlankCursor _ Cursor new.
  958.  
  959.     XeqCursor _ 
  960.         (Cursor
  961.             extent: 16@16
  962.             fromArray: #(
  963.         2r1000000000010000
  964.         2r1100000000010000
  965.         2r1110000000111000
  966.         2r1111000111111111
  967.         2r1111100011000110
  968.         2r1111110001000100
  969.         2r1111111001111100
  970.         2r1111000001101100
  971.         2r1101100011000110
  972.         2r1001100010000010
  973.         2r0000110000000000
  974.         2r0000110000000000
  975.         2r0000011000000000
  976.         2r0000011000000000
  977.         2r0000001100000000
  978.         2r0000001100000000)
  979.     offset: 0@0).
  980.  
  981.     SquareCursor _ 
  982.         (Cursor
  983.             extent: 16@16
  984.             fromArray: #(
  985.         2r0
  986.         2r0
  987.         2r0
  988.         2r0
  989.         2r0
  990.         2r0000001111000000
  991.         2r0000001111000000
  992.         2r0000001111000000
  993.         2r0000001111000000
  994.         2r0
  995.         2r0
  996.         2r0
  997.         2r0
  998.         2r0
  999.         2r0
  1000.         2r0)
  1001.     offset: -8@-8).
  1002.  
  1003.     NormalCursor _   
  1004.         (Cursor
  1005.             extent: 16@16
  1006.             fromArray: #(
  1007.         2r1000000000000000
  1008.         2r1100000000000000
  1009.         2r1110000000000000
  1010.         2r1111000000000000
  1011.         2r1111100000000000
  1012.         2r1111110000000000
  1013.         2r1111111000000000
  1014.         2r1111100000000000
  1015.         2r1111100000000000
  1016.         2r1001100000000000
  1017.         2r0000110000000000
  1018.         2r0000110000000000
  1019.         2r0000011000000000
  1020.         2r0000011000000000
  1021.         2r0000001100000000
  1022.         2r0000001100000000)
  1023.     offset: 0@0).
  1024.  
  1025.     CrossHairCursor _   
  1026.         (Cursor
  1027.             extent: 16@16
  1028.             fromArray: #(
  1029.         2r0000000100000000
  1030.         2r0000000100000000
  1031.         2r0000000100000000
  1032.         2r0000000100000000
  1033.         2r0000000100000000
  1034.         2r0000000100000000
  1035.         2r0000000100000000
  1036.         2r1111111111111110
  1037.         2r0000000100000000
  1038.         2r0000000100000000
  1039.         2r0000000100000000
  1040.         2r0000000100000000
  1041.         2r0000000100000000
  1042.         2r0000000100000000
  1043.         2r0000000100000000
  1044.         2r0)
  1045.             offset: -7@-7).
  1046.  
  1047.     MarkerCursor _ 
  1048.         Cursor
  1049.             extent: 16@16
  1050.             fromArray: #(
  1051.         2r0
  1052.         2r0
  1053.         2r0
  1054.         2r0000001000000000
  1055.         2r0000001110000000
  1056.         2r0000001111100000
  1057.         2r1111111111111000
  1058.         2r1111111111111110
  1059.         2r1111111111111000
  1060.         2r0000001111100000
  1061.         2r0000001110000000
  1062.         2r0000001000000000
  1063.         2r0
  1064.         2r0
  1065.         2r0
  1066.         2r0)
  1067.             offset: -7@-7.
  1068.  
  1069.     UpCursor _ 
  1070.         Cursor 
  1071.             extent: 16@16
  1072.             fromArray: #(
  1073.         2r1000000000000000
  1074.         2r1100000000000000
  1075.         2r1110000000000000
  1076.         2r1111000000000000
  1077.         2r1111100000000000
  1078.         2r1111110000000000
  1079.         2r1100000000000000
  1080.         2r1100000000000000
  1081.         2r1100000000000000
  1082.         2r1100000000000000
  1083.         2r1100000000000000
  1084.         2r1100000000000000
  1085.         2r1100000000000000
  1086.         2r1100000000000000
  1087.         2r1100000000000000
  1088.         2r1100000000000000)
  1089.              offset: 0@-7.
  1090.  
  1091.     DownCursor _
  1092.          Cursor 
  1093.             extent: 16@16
  1094.             fromArray: #(
  1095.         2r0000110000000000
  1096.         2r0000110000000000
  1097.         2r0000110000000000
  1098.         2r0000110000000000
  1099.         2r0000110000000000
  1100.         2r0000110000000000
  1101.         2r0000110000000000
  1102.         2r0000110000000000
  1103.         2r0000110000000000
  1104.         2r0000110000000000
  1105.         2r1111110000000000
  1106.         2r0111110000000000
  1107.         2r0011110000000000
  1108.         2r0001110000000000
  1109.         2r0000110000000000
  1110.         2r0000010000000000)
  1111.             offset: -5@-7.
  1112.  
  1113.     LeftCursor _ 
  1114.         Cursor 
  1115.             extent: 16@16
  1116.             fromArray: #(
  1117.         2r1111111111111111
  1118.         2r0111111111111111
  1119.         2r0011110000000000
  1120.         2r0001110000000000
  1121.         2r0000110000000000
  1122.         2r0000010000000000
  1123.         2r0000000000000000
  1124.         2r0000000000000000
  1125.         2r0000000000000000
  1126.         2r0000000000000000
  1127.         2r0000000000000000
  1128.         2r0000000000000000
  1129.         2r0000000000000000
  1130.         2r0000000000000000
  1131.         2r0000000000000000
  1132.         2r0000000000000000)
  1133.              offset: -7@0.
  1134.  
  1135.     RightCursor _
  1136.          Cursor 
  1137.             extent: 16@16
  1138.             fromArray: #(
  1139.         2r0000000000100000
  1140.         2r0000000000110000
  1141.         2r0000000000111000
  1142.         2r0000000000111100
  1143.         2r1111111111111110
  1144.         2r1111111111111111
  1145.         2r0000000000000000
  1146.         2r0000000000000000
  1147.         2r0000000000000000
  1148.         2r0000000000000000
  1149.         2r0000000000000000
  1150.         2r0000000000000000
  1151.         2r0000000000000000
  1152.         2r0000000000000000
  1153.         2r0000000000000000
  1154.         2r0000000000000000)
  1155.             offset: -7@-5.
  1156.     XMarkerCursor _ 
  1157.         Cursor
  1158.             extent: 16@16
  1159.             fromArray: #(
  1160.         2r0
  1161.         2r0000000100000000
  1162.         2r0000000100000000
  1163.         2r0000001110000000
  1164.         2r0000001110000000
  1165.         2r0000011111000000
  1166.         2r0000011111000000
  1167.         2r0000111111100000
  1168.         2r0000111111100000
  1169.         2r0001111111110000
  1170.         2r0000001110000000
  1171.         2r0000001110000000
  1172.         2r0000001110000000
  1173.         2r0000001110000000
  1174.         2r0000001110000000
  1175.         2r0000001110000000)
  1176.             offset: -7@-7.
  1177.     FourWay _ 
  1178.         Cursor
  1179.             extent: 16@16
  1180.             fromArray: #(
  1181.         2r0000000100000000
  1182.         2r0000001110000000
  1183.         2r0000011111000000
  1184.         2r0000111111100000
  1185.         2r0001001110010000
  1186.         2r0011001110011000
  1187.         2r0111111111111100
  1188.         2r1111111111111110
  1189.         2r0111111111111100
  1190.         2r0011001110011000
  1191.         2r0001001110010000
  1192.         2r0000111111100000
  1193.         2r0000011111000000
  1194.         2r0000001110000000
  1195.         2r0000000100000000
  1196.         2r0000000000000000)
  1197.             offset: -7@-7.
  1198.  
  1199. "Cursor initialize"! !Cursor initialize.!
  1200. DisplayObject subclass: #GraphHolder
  1201.     instanceVariableNames: 'nodes virtualNodes roots directed sides delta form offset boundingBox object '
  1202.     classVariableNames: ''
  1203.     poolDictionaries: ''
  1204.     category: 'Grapher'!
  1205. GraphHolder comment:
  1206. 'A GraphHolder provides the global organization required to present a
  1207. structured, graphical display of a data structure.  GraphHolders may
  1208. be created with the createTreeWithRoot: or createForestWithRoots:
  1209. messages in GraphHolder metaclass, or by the openOn:label: message
  1210. of GraphHolderView metaclass.  Also, it is possible, but not easy, to
  1211. use routines external to GraphHolder to create a graph.  After a graph
  1212. has been created it must have its elements positioned properly.  The
  1213. message layout: does this.  Its argument is an Array of formatting
  1214. symbols, which specify the various format options which are in effect
  1215. for this GraphHolder.  The format symbols currently recognized are:
  1216.  
  1217.     #horizontal        The default.  GraphHolders have roots to the left,
  1218.                     leaves to the right.
  1219.     #vertical        Roots at top, leaves at bottom.
  1220.     #reverse        Either right-left, or bottom-top.
  1221.  
  1222. My instance variables:
  1223.  
  1224.     nodes        <Dictionary from Object to GraphNode>
  1225.                 The nodes which make up a GraphHolder.
  1226.     virtualNodes <Dictionary from Object to Sets of GraphNode>
  1227.                 Nodes with multiple ''from'' fields are replicated here.
  1228.     roots        <Collection of Object>
  1229.                 The distinguished nodes which are the roots of a DAG.
  1230.     directed    <Boolean>
  1231.                 If true, I am a directed graph and links are fixed (e.g.
  1232.                 from bottom of a label to top of a child label).
  1233.                 If false, links may originate at whichever edge of
  1234.                 the label is convenient (modulo the value of sides).
  1235.     sides        <Boolean>
  1236.                 If true, links are drawn to the left or right of a node.
  1237.                 If false, links are drawn to the top or bottom of a node.
  1238.     delta        <Point>
  1239.                 The minimum distances between node labels. The x
  1240.                 value specifies the distance between parent/child.  The
  1241.                 y value, adjacent children.
  1242.     form        <Form or GraphHolder>
  1243.                 The object to be displayed.  If the display fits on a form
  1244.                 then a form is created and saved here.  Otherwise this
  1245.                 is a pointer back to the GraphHolder.  Only used for display.
  1246.     offset        <Point>
  1247.                 My display offset (in local view coordinates).
  1248.     boundingBox <Rectangle>
  1249.                 A rectangle large enough to hold my entire graphical
  1250.                 display, positioned in local view coordinates.
  1251.  
  1252. Currently, my sides and directed flags are unused.  They are provided for
  1253. compatability with future versions of Grapher which may support more
  1254. generalized layout options.
  1255.  
  1256. File out Grapher:
  1257.  
  1258.     | sourceStream |
  1259.     sourceStream _ FileStream newFileNamed: ''Grapher-1.st''.
  1260.     #(XAxisScrollController GraphHolderController GraphHolderView) do:
  1261.         [ :className |
  1262.         (Smalltalk at: className) fileOutOn: sourceStream].
  1263.     sourceStream nextChunkPut:
  1264. ''#(''''FourWay'''' ''''LeftCursor'''' ''''RightCursor'''' ''''XMarkerCursor'''') do:
  1265.     [ :var | Cursor addClassVarName: var].''; cr.
  1266.     #(fourWay left right xMarker initialize) do:
  1267.         [ :selector |
  1268.         Cursor class fileOutMessage: selector on: sourceStream moveSource: false toFile: 0].
  1269.     sourceStream nextChunkPut: ''Cursor initialize.''; cr.
  1270.     sourceStream close.
  1271.  
  1272.     | sourceStream |
  1273.     sourceStream _ FileStream newFileNamed: ''Grapher-2.st'' asFileName.
  1274.     #(GraphHolder GraphNode EmptyGraphNode) do:
  1275.         [ :className |
  1276.         (Smalltalk at: className) fileOutOn: sourceStream].
  1277.     Object fileOutCategory: ''grapher access'' asSymbol on: sourceStream moveSource: false toFile: 0.
  1278.     WordArray class fileOutCategory: ''class access'' asSymbol on: sourceStream moveSource: false toFile: 0.
  1279.     sourceStream close.
  1280. '!
  1281.  
  1282.  
  1283. !GraphHolder methodsFor: 'initialize-release'!
  1284.  
  1285. initialize
  1286.  
  1287.     sides _ true.
  1288.     directed _ false.
  1289.     offset _ 0@0!
  1290.  
  1291. release
  1292.  
  1293.     object removeDependent: self.
  1294.     object _ nil.
  1295.     form _ nil! !
  1296.  
  1297. !GraphHolder methodsFor: 'accessing'!
  1298.  
  1299. directed
  1300.     ^directed!
  1301.  
  1302. directed: aBool
  1303.     directed _ aBool!
  1304.  
  1305. form
  1306.  
  1307.     form == nil
  1308.         ifTrue: [self composeForm].
  1309.     ^form!
  1310.  
  1311. nodes
  1312.     ^nodes!
  1313.  
  1314. offset
  1315.     ^offset!
  1316.  
  1317. offset: aPoint
  1318.     offset _ aPoint!
  1319.  
  1320. roots
  1321.  
  1322.     "Chris Jacobson 7-9-86"
  1323.     ^roots!
  1324.  
  1325. selectNodeAt: selectionPoint
  1326.  
  1327.     | selection |
  1328.     selection _ nodes detect: [ :node | node containsPoint: selectionPoint]
  1329.                        ifNone: [nil].
  1330.     selection == nil & (virtualNodes ~= nil) ifTrue:
  1331.         [virtualNodes do:
  1332.             [ :group |
  1333.             selection _ group detect: [ :node | node containsPoint: selectionPoint]
  1334.                                ifNone: [nil].
  1335.             selection == nil
  1336.                 ifFalse: [^selection]]].
  1337.     ^selection!
  1338.  
  1339. sides
  1340.     ^sides!
  1341.  
  1342. sides: aBool
  1343.     sides _ aBool! !
  1344.  
  1345. !GraphHolder methodsFor: 'testing'!
  1346.  
  1347. isEmpty
  1348.  
  1349.     ^(nodes size = 1) and: [nodes keysDo: [:node | ^node class == EmptyGraphNode]]! !
  1350.  
  1351. !GraphHolder methodsFor: 'display box access'!
  1352.  
  1353. boundingBox
  1354.  
  1355.     boundingBox == nil
  1356.         ifTrue: [boundingBox _ self computeBoundingBox].
  1357.     ^boundingBox!
  1358.  
  1359. computeBoundingBox
  1360.  
  1361.     self layout.
  1362.     ^boundingBox! !
  1363.  
  1364. !GraphHolder methodsFor: 'displaying'!
  1365.  
  1366. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger mask: aForm
  1367.  
  1368.     | displayPoint blter |
  1369.     displayPoint _ aDisplayPoint + offset.
  1370.     blter _ BitBlt
  1371.         destForm: aDisplayMedium
  1372.         sourceForm: (Form extent: 1@1) black
  1373.         halftoneForm: aForm
  1374.         combinationRule: ruleInteger
  1375.         destOrigin: 0@0
  1376.         sourceOrigin: 0@0
  1377.         extent: 1@1
  1378.         clipRect: clipRectangle.
  1379.     nodes do:
  1380.         [ :node |
  1381.         node to do:
  1382.             [ :child |
  1383.             blter drawFrom: displayPoint + node fromPt
  1384.                   to: displayPoint + child toPt]].
  1385.     nodes do:
  1386.         [ :node |
  1387.         node
  1388.             displayOn: aDisplayMedium
  1389.             at: displayPoint
  1390.             clippingBox: clipRectangle
  1391.             rule: ruleInteger
  1392.             mask: aForm].
  1393.     virtualNodes == nil ifFalse:
  1394.         [virtualNodes do:
  1395.             [ :share | share do:
  1396.                 [ :node |
  1397.                 node            
  1398.                     displayOn: aDisplayMedium
  1399.                     at: displayPoint
  1400.                     clippingBox: clipRectangle
  1401.                     rule: ruleInteger
  1402.                     mask: aForm]]]!
  1403.  
  1404. displayOn: aDisplayMedium transformation: aDisplayTransformation clippingBox: aRectangle rule: ruleInteger mask: aHalfTone
  1405.  
  1406.     self form
  1407.         displayOn: aDisplayMedium
  1408.         transformation: aDisplayTransformation
  1409.         clippingBox: aRectangle
  1410.         rule: ruleInteger
  1411.         mask: aHalfTone!
  1412.  
  1413. view
  1414.  
  1415.     self displayOn: self form at: 0@0.
  1416.     form openAs: 
  1417.         (roots size = 1
  1418.             ifTrue: ['Tree']
  1419.             ifFalse: ['Forest'])! !
  1420.  
  1421. !GraphHolder methodsFor: 'graph layout'!
  1422.  
  1423. layout
  1424.     "Default format."
  1425.  
  1426.     self layout: #( #horizontal )!
  1427.  
  1428. layout: format
  1429.  
  1430.     | messages realOffset extents max horizontal |
  1431.     delta == nil ifTrue: [delta _ 30@30].
  1432.     messages _ (nodes at: roots first) formatMessages: format.
  1433.     horizontal _ format includes: #horizontal.
  1434.     realOffset _ offset copy.
  1435.     extents _ OrderedCollection new: roots size.
  1436.     max _ 0.
  1437.     roots do:
  1438.         [ :root |
  1439.         extents addLast:
  1440.             ((nodes at: root) extentOfGraph: self
  1441.                               withDelta: delta
  1442.                               formatMessages: (messages at: 1))].
  1443.     1 to: roots size do:
  1444.         [ :n |
  1445.         (nodes at: (roots at: n))
  1446.             setPosition: offset
  1447.             withDelta: delta
  1448.             forGraph: self
  1449.             formatMessages: (messages at: 2).
  1450.         horizontal
  1451.             ifTrue: [max _ max max: (extents at: n) x.
  1452.                     offset y: offset y + (extents at: n) y + delta y]
  1453.             ifFalse: [max _ max max: (extents at: n) y.
  1454.                     offset x: offset x + (extents at: n) x + delta x]].
  1455.     horizontal
  1456.         ifTrue: [boundingBox _ 0@0 extent: (max + delta x @ offset y).
  1457.                 offset _ realOffset.
  1458.                 offset x: offset x + (delta x // 2)]
  1459.         ifFalse: [boundingBox _ 0@0 extent: offset x @ (max + delta y).
  1460.                 offset _ realOffset.
  1461.                 offset y: offset y + (delta y // 2)]! !
  1462.  
  1463. !GraphHolder methodsFor: 'graph setup'!
  1464.  
  1465. addNode: newNode
  1466.     "Add a 'virtual' node to the graph.  Virtual nodes have no children;
  1467.     they serve as markers for nodes with multiple from nodes."
  1468.  
  1469.     virtualNodes == nil ifTrue: [virtualNodes _ IdentityDictionary new: 16].
  1470.     (virtualNodes at: newNode object
  1471.            ifAbsent: [virtualNodes at: newNode object put: (OrderedCollection new: 5)])
  1472.         addLast: newNode!
  1473.  
  1474. forestFrom: rootObjs children: childrenMsg label: labelMsg
  1475.  
  1476.     | index |
  1477.     nodes _ IdentityDictionary new: 64.
  1478.     object _ rootObjs.
  1479.     roots _ Array new: rootObjs size.
  1480.     index _ 1.
  1481.     rootObjs do:
  1482.         [ :root |
  1483.         roots at: index put: root.
  1484.         index _ index + 1.
  1485.         self newGraphNode: root
  1486.             fromNode: nil
  1487.             children: childrenMsg
  1488.             label: labelMsg]!
  1489.  
  1490. newGraphNode: nodeObj fromNode: fromNode children: childrenMsg label: labelMsg
  1491.     "Add another graphNode (for nodeObj) to the graph.  Its
  1492.     immediate parent is fromNode. 'Ware circularities!!"
  1493.  
  1494.     | graphNode toNodes children |
  1495.     graphNode _ nodes at: nodeObj ifAbsent:
  1496.         [graphNode _ GraphNode from: fromNode
  1497.                                    object: nodeObj
  1498.                                    label: (nodeObj perform: labelMsg).
  1499.         children _ nodeObj perform: childrenMsg.
  1500.         toNodes _ OrderedCollection new: children size.
  1501.         children do:
  1502.             [ :child |
  1503.             toNodes addLast: (self newGraphNode: child
  1504.                                     fromNode: graphNode
  1505.                                     children: childrenMsg
  1506.                                     label: labelMsg)].
  1507.         graphNode to: toNodes asArray.
  1508.         nodes at: nodeObj put: graphNode.
  1509.         ^graphNode].
  1510.     graphNode addFromNode: fromNode.
  1511.     ^graphNode! !
  1512.  
  1513. !GraphHolder methodsFor: 'graph hardcopy'!
  1514.  
  1515. psEpilogueOn: aStream
  1516.  
  1517.     aStream lf!
  1518.  
  1519. psLine: beginPt to: endPt on: aStream
  1520.  
  1521.     beginPt x printOn: aStream.
  1522.     aStream space.
  1523.     beginPt y printOn: aStream.
  1524.     aStream space.
  1525.     endPt x printOn: aStream.
  1526.     aStream space.
  1527.     endPt y printOn: aStream.
  1528.     aStream space; nextPutAll: 'Line'; lf!
  1529.  
  1530. psPrologueOn: aStream
  1531.  
  1532.     aStream lf.
  1533.     offset x negated printOn: aStream.
  1534.     aStream space.
  1535.     offset y negated printOn: aStream.
  1536.     aStream space.
  1537.     boundingBox extent x printOn: aStream.
  1538.     aStream space.
  1539.     boundingBox extent y printOn: aStream.
  1540.     aStream space; nextPutAll: 'SetPage'; lf!
  1541.  
  1542. psScriptOn: aStream
  1543.  
  1544.     nodes do:
  1545.         [ :node |
  1546.         node to do:
  1547.             [ :child |
  1548.             self psLine: node fromPt to: child toPt on: aStream ]].
  1549.     nodes do:
  1550.         [ :node |
  1551.         node psStoreOn: aStream ].
  1552.     virtualNodes == nil ifFalse:
  1553.         [virtualNodes do:
  1554.             [ :share |
  1555.             share do:
  1556.                 [ :node |
  1557.                 node boxYourself.        "workaround for a slight glitch"
  1558.                 node psStoreOn: aStream ]]]!
  1559.  
  1560. psStoreOn: aStream
  1561.     "Store the PostScript code to reproduce me on aStream.  This set of
  1562.     methods requires some external PostScript definitions for SetPage,
  1563.     Box, Line, and Label."
  1564.  
  1565.     self psPrologueOn: aStream.
  1566.     self psScriptOn: aStream.
  1567.     self psEpilogueOn: aStream! !
  1568.  
  1569. !GraphHolder methodsFor: 'updating'!
  1570.  
  1571. update: anArray
  1572.     "Recompute the displayed representation, starting from the roots in anArray."
  1573.  
  1574.     (anArray isKindOf: Array) ifTrue: [
  1575.         (anArray size > 0) ifTrue: [
  1576.             form _ nil.
  1577.             offset _ 0@0.
  1578.             virtualNodes _ nil.
  1579.             self forestFrom: anArray children: #children label: #graphLabel.
  1580.             boundingBox _ nil.
  1581.             self changed: #all]]! !
  1582.  
  1583. !GraphHolder methodsFor: 'private'!
  1584.  
  1585. composeForm
  1586.  
  1587.     self boundingBox extent x +15 // 16
  1588.     * self boundingBox extent y > WordArray maxSize
  1589.         ifFalse: [form _ Form extent: self boundingBox extent.
  1590.                 self displayOn: form at: 0@0.
  1591.                 self changed: #form]
  1592.         ifTrue: [form _ self.
  1593.                 self changed: #noform]! !
  1594. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1595.  
  1596. GraphHolder class
  1597.     instanceVariableNames: ''!
  1598.  
  1599.  
  1600. !GraphHolder class methodsFor: 'instance creation'!
  1601.  
  1602. createEmpty
  1603.  
  1604.     ^self createTreeWithRoot: (EmptyGraphNode new)!
  1605.  
  1606. createForestWithRoots: objs
  1607.  
  1608.     ^self createForestWithRoots: objs children: #children label: #graphLabel!
  1609.  
  1610. createForestWithRoots: objs children: childrenMsg label: labelMsg
  1611.     "Create a forest rooted at objs.  Use the message selector in
  1612.     childrenMsg to get the children of node.  Use the selector in
  1613.     labelMsg to get the label of a node."
  1614.  
  1615.     ^self new forestFrom: objs children: childrenMsg label: labelMsg!
  1616.  
  1617. createTreeWithRoot: obj
  1618.  
  1619.     ^self createForestWithRoots: (Array with: obj)!
  1620.  
  1621. new
  1622.     ^super new initialize! !
  1623.  
  1624. !GraphHolder class methodsFor: 'examples'!
  1625.  
  1626. example1
  1627.     "If 'children' and 'graphLabel' have been defined in Object then
  1628.     display the inheritance heirarchy for Number."
  1629.  
  1630.     GraphHolderView openOn: (Array with: Magnitude)
  1631.                 label: 'Magnitude'
  1632.                 format: #( #horizontal )
  1633.  
  1634.     "GraphHolder example1"
  1635.  
  1636.     "definition of children for Object"
  1637. "children
  1638.     ^self subclasses"
  1639.  
  1640.     "definition of graphLabel for Object"
  1641. "graphLabel
  1642.     ^self name asText"!
  1643.  
  1644. example2
  1645.     "If 'children' and 'graphLabel' have been defined in Object then
  1646.     display the inheritance heirarchies for View and Controller."
  1647.  
  1648.     GraphHolderView openOn: (Array with: View with: Controller)
  1649.                 label: 'Windows'
  1650.  
  1651.     "GraphHolder example2"!
  1652.  
  1653. example3
  1654.     "If 'children' and 'graphLabel' have been defined in Object then
  1655.     display the inheritance heirarchies for Collection.  This
  1656.     version has an ActionMenu which allows interaction with the objects
  1657.     displayed."
  1658.  
  1659.     GraphHolderView
  1660.         openOn: (Array with: Collection)
  1661.         label: 'Collections'
  1662.         format: #(#horizontal)
  1663.         menu: (ActionMenu
  1664.             labels: 'browser\inspect' withCRs
  1665.             lines: #(1)
  1666.             selectors: #(browse inspect))
  1667.  
  1668.     "GraphHolder example3"!
  1669.  
  1670. example4
  1671.     "If 'graphLabel' has been defined in Object then
  1672.     display the dependency links for the current Project.  This
  1673.     version has an ActionMenu which allows interaction with the objects
  1674.     displayed."
  1675.  
  1676.     GraphHolderView
  1677.         openOn: (Array with: Project current)
  1678.         label: 'Current Project'
  1679.         format: #(#horizontal)
  1680.         menu: (ActionMenu
  1681.             labels: 'inspect'
  1682.             selectors: #(inspect))
  1683.         childrenMsg: #dependents
  1684.         labelMsg: #graphLabel
  1685.  
  1686.     "GraphHolder example4"! !DisplayText subclass: #GraphNode
  1687.     instanceVariableNames: 'object from to fromPt toPt boxed '
  1688.     classVariableNames: ''
  1689.     poolDictionaries: ''
  1690.     category: 'Grapher'!
  1691. GraphNode comment:
  1692. 'My instance variables:
  1693.  
  1694.     object        <Object>
  1695.                 Reference to the object which I am to display.
  1696.     from        <Array of Integer>
  1697.                 A list of GraphNode id''s. A link fruns from each node
  1698.                 in this list to me.
  1699.     to            <Array of Integer>
  1700.                 A list of GraphNode id''s. A link fruns from me to each
  1701.                 node in this list.
  1702.     fromPt        <Point>
  1703.                 The location (wrt offset) on my form where my to
  1704.                 links begin.
  1705.     toPt        <Point>
  1706.                 The location (wrt offset) on my form where my from
  1707.                 links end.
  1708.     boxed        <Boolean>
  1709.                 If true, a box is to drawn around my form.  Only valid
  1710.                 for ''real'' nodes (ie those GraphNodes in the nodes
  1711.                 field of GraphHolder, not the virtualNodes field).
  1712. '!
  1713.  
  1714.  
  1715. !GraphNode methodsFor: 'initialize-release'!
  1716.  
  1717. initialize
  1718.  
  1719.     boxed _ false! !
  1720.  
  1721. !GraphNode methodsFor: 'accessing'!
  1722.  
  1723. from
  1724.     ^from!
  1725.  
  1726. from: fromNodes
  1727.     from _ fromNodes!
  1728.  
  1729. fromPt
  1730.     ^fromPt!
  1731.  
  1732. object
  1733.     ^object!
  1734.  
  1735. to
  1736.     ^to!
  1737.  
  1738. to: toNodes
  1739.     to _ toNodes!
  1740.  
  1741. toPt
  1742.     ^toPt!
  1743.  
  1744. visited
  1745.     "Boxed is used as a temporary indicator: it is set to true
  1746.     during pass one, then false in pass two.  Shared nodes
  1747.     remain true."
  1748.  
  1749.     ^toPt ~= nil and: [to size > 0]! !
  1750.  
  1751. !GraphNode methodsFor: 'testing'!
  1752.  
  1753. containsPoint: aPoint
  1754.  
  1755.     ^(Rectangle origin: offset extent: form boundingBox extent)
  1756.         containsPoint: aPoint! !
  1757.  
  1758. !GraphNode methodsFor: 'editing'!
  1759.  
  1760. addFromNode: new
  1761.  
  1762.     from _ from copyWith: new!
  1763.  
  1764. addToNode: new
  1765.  
  1766.     to _ to copyWith: new!
  1767.  
  1768. boxYourself
  1769.  
  1770.     | newForm |
  1771.     boxed
  1772.         ifTrue: [^self].
  1773.     form border: form boundingBox width: 1.
  1774.     boxed _ true!
  1775.  
  1776. deleteFromNode: old
  1777.  
  1778.     from _ from copyWithout: old!
  1779.  
  1780. deleteToNode: old
  1781.  
  1782.     to _ to copyWithout: old! !
  1783.  
  1784. !GraphNode methodsFor: 'display box access'!
  1785.  
  1786. bottomCenter
  1787.  
  1788.     ^self form boundingBox bottomCenter + offset!
  1789.  
  1790. boundingBox
  1791.     ^self form boundingBox!
  1792.  
  1793. leftCenter
  1794.  
  1795.     ^self form boundingBox leftCenter + offset!
  1796.  
  1797. origin
  1798.  
  1799.     ^self form boundingBox origin + offset!
  1800.  
  1801. rightCenter
  1802.  
  1803.     ^self form boundingBox rightCenter + offset!
  1804.  
  1805. topCenter
  1806.  
  1807.     ^self form boundingBox topCenter + offset! !
  1808.  
  1809. !GraphNode methodsFor: 'graph layout'!
  1810.  
  1811. extentOfGraph: graph withDelta: delta formatMessages: msgs
  1812.     "Determine the extent of the rectangular area required
  1813.     to hold the subtree of which I am the root.  Save the extent
  1814.     temporarily in offset (till we get to setPosition:...)."
  1815.  
  1816.     | boundingBox labelBox updateMsg childExtent |
  1817.     labelBox _ self boundingBox.
  1818.     boxed ifTrue:
  1819.         [^self perform: (msgs at: 1) with: labelBox extent with: delta].
  1820.     to size = 0 ifTrue:
  1821.         [^offset _ self perform: (msgs at: 1) with: labelBox extent with: delta].
  1822.     boxed _ true.
  1823.     updateMsg _ msgs at: 2.
  1824.     to do:
  1825.         [ :child |
  1826.         childExtent _ child extentOfGraph: graph
  1827.                             withDelta: delta
  1828.                             formatMessages: msgs.
  1829.         self perform: updateMsg with: childExtent].
  1830.     self perform: (msgs at: 3) with: labelBox extent with: delta.
  1831.     ^offset!
  1832.  
  1833. formatMessages: format
  1834.  
  1835.     (format includes: #vertical)
  1836.         ifTrue:
  1837.             [(format includes: #reverse)
  1838.                 ifTrue: [^self reverseVerticalFormat]
  1839.                 ifFalse: [^self verticalFormat]].
  1840.     (format includes: #horizontal)
  1841.         ifTrue:
  1842.             [(format includes: #reverse)
  1843.                 ifTrue: [^self reverseHorizontalFormat]
  1844.                 ifFalse: [^self horizontalFormat]].
  1845.     self error: 'Unknown graph format.'!
  1846.  
  1847. horizontalFormat
  1848.  
  1849.     ^Array
  1850.         with:
  1851.             #(    #horizExtent:with:
  1852.                 #horizAdjustOffset:
  1853.                 #horizAddLabel:with: )
  1854.         with:
  1855.             #(    #leftCenter
  1856.                 #horizWidth:with:
  1857.                 #horizFixedSubOrigin:with:with:
  1858.                 #horizVariableSubOrigin:
  1859.                 #horizNewSubOrigin:with: )!
  1860.  
  1861. reverseHorizontalFormat
  1862.  
  1863.     ^Array
  1864.         with:
  1865.             #(    #horizExtent:with:
  1866.                 #horizAdjustOffset:
  1867.                 #horizAddLabel:with: )
  1868.         with:
  1869.             #(    #rightCenter
  1870.                 #horizWidth:with:
  1871.                 #revHorizFixedSubOrigin:with:with:
  1872.                 #horizVariableSubOrigin:
  1873.                 #horizNewSubOrigin:with: )!
  1874.  
  1875. reverseVerticalFormat
  1876.  
  1877.     ^Array
  1878.         with:
  1879.             #(    #vertExtent:with:
  1880.                 #vertAdjustOffset:
  1881.                 #vertAddLabel:with: )
  1882.         with:
  1883.             #(    #bottomCenter
  1884.                 #vertWidth:with:
  1885.                 #revVertFixedSubOrigin:with:with:
  1886.                 #vertVariableSubOrigin:
  1887.                 #vertNewSubOrigin:with: )!
  1888.  
  1889. setPosition: origin withDelta: delta forGraph: graph formatMessages: msgs
  1890.     "Allocate space for each of my children side-by-side and
  1891.     assign a value to offset which results in my form being appropriately
  1892.     centered in my display rectangle."
  1893.  
  1894.     | area labelBox x d w child |
  1895.     labelBox _ self boundingBox.
  1896.     area _ origin extent: offset.
  1897.     offset _ 0@0.
  1898.     boxed _ false.
  1899.     to size = 0 ifTrue:
  1900.         [self align: (labelBox perform: (msgs at: 1))
  1901.               with: (area perform: (msgs at: 1)).
  1902.         toPt _ offset + (labelBox perform: (msgs at: 1)).
  1903.         ^self perform: (msgs at: 2) with: labelBox extent with: delta].
  1904.     self align: (labelBox perform: (msgs at: 1))
  1905.         with: (area perform: (msgs at: 1)).
  1906.     toPt _ offset + (labelBox perform: (msgs at: 1)).
  1907.     fromPt _ offset + (labelBox perform: (self oppositeCenter: (msgs at: 1))).
  1908.     x _ self perform: (msgs at: 3)
  1909.             with: area
  1910.             with: labelBox extent
  1911.             with: delta.
  1912.     w _ 0.
  1913.     d _ self perform: (msgs at: 4) with: area origin.
  1914.     1 to: to size do:
  1915.         [ :n |
  1916.         child _ to at: n.
  1917.         child visited ifTrue:
  1918.             [child boxYourself.
  1919.             child _ child copy.
  1920.             child offset: child boundingBox extent + delta.
  1921.             child to: Array new.
  1922.             graph addNode: child.
  1923.             to at: n put: child].
  1924.         w _ w + (child setPosition: (self perform: (msgs at: 5)
  1925.                                           with: x
  1926.                                           with: d+w)
  1927.                         withDelta: delta
  1928.                         forGraph: graph
  1929.                         formatMessages: msgs)].
  1930.     ^w!
  1931.  
  1932. verticalFormat
  1933.  
  1934.     ^Array
  1935.         with:
  1936.             #(    #vertExtent:with:
  1937.                 #vertAdjustOffset:
  1938.                 #vertAddLabel:with: )
  1939.         with:
  1940.             #(    #topCenter
  1941.                 #vertWidth:with:
  1942.                 #vertFixedSubOrigin:with:with:
  1943.                 #vertVariableSubOrigin:
  1944.                 #vertNewSubOrigin:with: )! !
  1945.  
  1946. !GraphNode methodsFor: 'graph formating'!
  1947.  
  1948. horizAddLabel: labelExtent with: delta
  1949.     "This message belongs in position 3 of extentOfGraph:"
  1950.  
  1951.     offset y: (offset y max: (labelExtent y + delta y)).
  1952.     offset x: offset x + labelExtent x + delta x!
  1953.  
  1954. horizAdjustOffset: subExtent
  1955.     "This message belongs in position 2 of extentOfGraph:"
  1956.  
  1957.     offset y: offset y + subExtent y.
  1958.     offset x: (offset x max: subExtent x)!
  1959.  
  1960. horizExtent: extent with: delta
  1961.     "This message belongs in position 1 for extentOfGraph:"
  1962.  
  1963.     ^extent + (0 @ delta y)!
  1964.  
  1965. horizFixedSubOrigin: area with: extent with: delta
  1966.     "This message belongs in position 3 of extentOfGraph:"
  1967.  
  1968.     ^area origin x + extent x + delta x!
  1969.  
  1970. horizNewSubOrigin: x with: y
  1971.     "This message belongs in position 5 of extentOfGraph:"
  1972.  
  1973.     ^x @ y!
  1974.  
  1975. horizVariableSubOrigin: origin
  1976.     "This message belongs in position 4 of extentOfGraph:"
  1977.  
  1978.     ^origin y!
  1979.  
  1980. horizWidth: extent with: delta
  1981.     "This message belongs in position 2 of setPosition:
  1982.     (Note that a message in Rectangle goes in position 1)"
  1983.  
  1984.     ^extent y + delta y!
  1985.  
  1986. oppositeCenter: aSymbol
  1987.  
  1988.     aSymbol == #topCenter ifTrue: [^#bottomCenter].
  1989.     aSymbol == #leftCenter ifTrue: [^#rightCenter].
  1990.     aSymbol == #bottomCenter ifTrue: [^#topCenter].
  1991.     aSymbol == #rightCenter ifTrue: [^#leftCenter]!
  1992.  
  1993. revHorizFixedSubOrigin: area with: extent with: delta
  1994.     "This message belongs in position 3 of extentOfGraph:"
  1995.  
  1996.     ^area origin x!
  1997.  
  1998. revVertFixedSubOrigin: area with: extent with: delta
  1999.     "This message belongs in position 3 of extentOfGraph:"
  2000.  
  2001.     ^area origin y!
  2002.  
  2003. vertAddLabel: labelExtent with: delta
  2004.     "This message belongs in position 3 of extentOfGraph:"
  2005.  
  2006.     offset x: (offset x max: (labelExtent x + delta x)).
  2007.     offset y: offset y + labelExtent y + delta y!
  2008.  
  2009. vertAdjustOffset: subExtent
  2010.     "This message belongs in position 2 of extentOfGraph:"
  2011.  
  2012.     offset x: offset x + subExtent x.
  2013.     offset y: (offset y max: subExtent y)!
  2014.  
  2015. vertExtent: extent with: delta
  2016.     "This message belongs in position 1 for extentOfGraph:"
  2017.  
  2018.     ^extent + (delta x @ 0)!
  2019.  
  2020. vertFixedSubOrigin: area with: extent with: delta
  2021.     "This message belongs in position 3 of extentOfGraph:"
  2022.  
  2023.     ^area origin y + extent y + delta y!
  2024.  
  2025. vertNewSubOrigin: y with: x
  2026.     "This message belongs in position 5 of extentOfGraph:"
  2027.  
  2028.     ^x @ y!
  2029.  
  2030. vertVariableSubOrigin: origin
  2031.     "This message belongs in position 4 of extentOfGraph:"
  2032.  
  2033.     ^origin x!
  2034.  
  2035. vertWidth: extent with: delta
  2036.     "This message belongs in position 2 of setPosition:
  2037.     (Note that a message in Rectangle goes in position 1)"
  2038.  
  2039.     ^extent x + delta x! !
  2040.  
  2041. !GraphNode methodsFor: 'graph hardcopy'!
  2042.  
  2043. psStoreOn: aStream
  2044.  
  2045.     | insetBox |
  2046.     insetBox _ (offset extent: self form boundingBox extent) insetBy: 2@2.
  2047.     boxed ifTrue:
  2048.         [offset x printOn: aStream.
  2049.         aStream space.
  2050.         offset y printOn: aStream.
  2051.         aStream space.
  2052.         insetBox corner x + 2 printOn: aStream.
  2053.         aStream space.
  2054.         insetBox corner y + 2 printOn: aStream.
  2055.         aStream space; nextPutAll: 'Box'; lf].
  2056.     insetBox origin x printOn: aStream.
  2057.     aStream space.
  2058.     insetBox origin y printOn: aStream.
  2059.     aStream space; nextPut: $(; nextPutAll: text string; nextPut: $);
  2060.         space; nextPutAll: 'Label'; lf.! !
  2061.  
  2062. !GraphNode methodsFor: 'private'!
  2063.  
  2064. composeForm
  2065.  
  2066.     | newForm |
  2067.  
  2068.     super composeForm.
  2069.     newForm _ Form extent: form boundingBox extent + (4@4).
  2070.     newForm white.
  2071.     form displayOn: newForm at: 2@2.
  2072.     form _ newForm!
  2073.  
  2074. from: fromNodes to: toNodes object: myObject label: label
  2075.  
  2076.     from _ fromNodes.
  2077.     to _ toNodes.
  2078.     object _ myObject.
  2079.     (label isKindOf: DisplayObject)
  2080.         ifTrue: [form _ label.
  2081.                 offset _ 0@0]
  2082.         ifFalse: [self setText: label asText
  2083.                 textStyle: DefaultTextStyle copy
  2084.                 offset: 0@0]! !
  2085. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2086.  
  2087. GraphNode class
  2088.     instanceVariableNames: ''!
  2089.  
  2090.  
  2091. !GraphNode class methodsFor: 'instance creation'!
  2092.  
  2093. from: fromID object: obj
  2094.  
  2095.     ^self from: (Array with: fromID) to: nil object: obj label: obj graphLabel!
  2096.  
  2097. from: fromID object: obj label: graphLabel
  2098.  
  2099.     ^self from: (Array with: fromID) to: nil object: obj label: graphLabel!
  2100.  
  2101. from: fromIDs to: toIDs object: obj
  2102.  
  2103.     ^self from: fromIDs to: toIDs object: obj label: obj graphLabel!
  2104.  
  2105. from: fromIDs to: toIDs object: obj label: label
  2106.  
  2107.     ^self new from: fromIDs to: toIDs object: obj label: label!
  2108.  
  2109. new
  2110.     ^super new initialize!
  2111.  
  2112. to: toID object: obj
  2113.  
  2114.     ^self from: nil to: (Array with: toID) object: obj label: obj graphLabel! !Object subclass: #EmptyGraphNode
  2115.     instanceVariableNames: 'graphLabel children '
  2116.     classVariableNames: ''
  2117.     poolDictionaries: ''
  2118.     category: 'Grapher'!
  2119.  
  2120.  
  2121. !EmptyGraphNode methodsFor: 'accessing'!
  2122.  
  2123. children
  2124.  
  2125.     ^children!
  2126.  
  2127. graphLabel
  2128.  
  2129.     ^graphLabel! !
  2130.  
  2131. !EmptyGraphNode methodsFor: 'initialize'!
  2132.  
  2133. initialize
  2134.  
  2135.     graphLabel _ (Form dotOfSize: 0).
  2136.     children _ #()! !
  2137. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2138.  
  2139. EmptyGraphNode class
  2140.     instanceVariableNames: ''!
  2141.  
  2142.  
  2143. !EmptyGraphNode class methodsFor: 'instance creation'!
  2144.  
  2145. new
  2146.  
  2147.     ^super new initialize! !
  2148.  
  2149. !Object methodsFor: 'grapher access'!
  2150.  
  2151. children
  2152.     ^self subclasses!
  2153.  
  2154. graphLabel
  2155.     "Answer with a Text used by Grapher."
  2156.  
  2157.     (self isKindOf: Class)
  2158.         ifTrue: [^self name asText allBold]
  2159.         ifFalse: [^self class name asText allBold]! !
  2160.  
  2161. !WordArray class methodsFor: 'class access'!
  2162.  
  2163. maxSize
  2164.     "Answer with the maximum size of instances of the receiver."
  2165.  
  2166.